home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / MISC.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  7KB  |  268 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  7-1-88 8:16 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13.  
  14. Unit Misc;
  15.  
  16. Interface
  17.  
  18. Uses
  19.   TpCrt, Dos, TPSTRING, Core1,
  20.   Core2, Globals, BinEd;
  21.   
  22.   
  23. procedure MakeWindow;
  24.  
  25. procedure full_screen_edit(EditFile : StrStd; Mode : Char; var abort : Boolean);
  26.  
  27.  
  28.   {==========================================================================}
  29.   
  30.   
  31. Implementation
  32.  
  33.  
  34.   procedure MakeWindow;
  35.   
  36.   const
  37.     X1              = 11;
  38.     Y1              = 7;
  39.     X2              = 70;
  40.     Y2              = 16;
  41.     Frame_Color     = $17;
  42.     Title_Color     = $17;
  43.     
  44.   var
  45.     i               : Integer;
  46.     lt              : Integer;
  47.     where           : Integer;
  48.     tempstr         : string;
  49.     OK              : Boolean;
  50.     t               : tad_array;
  51.     strtd           : StrTAD;
  52.     
  53.   begin
  54.   
  55.     Window(11, 7, 70, 16);
  56.     TextBackground(1);
  57.     ClrScr;
  58.     Window(1, 1, 80, 25);
  59.     TextBackground(0);
  60.     
  61.     FastWrite('╒', Y1, X1, Frame_Color);
  62.     tempstr := '';
  63.     for i := (X1+1) to (X2-1) do
  64.       tempstr := tempstr+'═';
  65.       
  66.     GetTAD(t);
  67.     strtd := FormTAD(t);
  68.     if Pos('   ', strtd) > 1 then
  69.       Delete(strtd, Pos('   ', strtd), 1);
  70.       
  71.     lt := Length(tempstr);
  72.     where := (lt-Length(strtd)) div 2;
  73.     
  74.     FastWrite(tempstr, Y1, X1+1, Frame_Color);
  75.     FastWrite(strtd, Y1, X1+where, $4E);
  76.     
  77.     FastWrite('╕', Y1, X2, Frame_Color);
  78.     
  79.     for i := (Y1+1) to (Y2-1) do
  80.       begin
  81.         FastWrite('│', i, X1, Frame_Color);
  82.         FastWrite('│', i, X2, Frame_Color);
  83.       end;
  84.       
  85.     FastWrite('╘', Y2, X1, Frame_Color);
  86.     
  87.     tempstr := '';
  88.     for i := (X1+1) to (X2-1) do
  89.       tempstr := tempstr+'═';
  90.       
  91.     FastWrite(tempstr, Y2, X1+1, Frame_Color);
  92.     FastWrite('╛', Y2, X2, Frame_Color);
  93.     
  94.     {$I-}
  95.     Seek(logr_file, 0); {$I+}
  96.     OK := (IoResult = 0);
  97.     if OK then
  98.       begin
  99.         {$I-}
  100.         Read(logr_file, logr_rec); {$I+}
  101.         OK := (IoResult = 0);
  102.         if OK then
  103.           FastWrite(' Last Caller Number..'+Long2Str(logr_rec.user),
  104.             9, 12, Title_Color);
  105.       end;
  106.     if auto_macro then
  107.       tempstr := ' Automatic Macro.....ENABLED at '+Long2Str(auto_macro_start)
  108.       +':00.'
  109.     else
  110.       tempstr := ' Automatic Macro.....OFF.';
  111.     FastWrite(tempstr, 10, 12, Title_Color);
  112.     if restrict300 then
  113.       tempstr := ' 300 Baud Callers....RESTRICTED '+Long2Str(start_restrict300)+
  114.       ':00 - '+Long2Str(end_restrict300)+':00 Hours.'
  115.     else
  116.       tempstr := ' 300 Baud Callers....OK.';
  117.     FastWrite(tempstr, 11, 12, Title_Color);
  118.     if chat_ok then
  119.       tempstr := ' Chat Function.......ENABLED '+Long2Str(chatstart)+
  120.       ':00 - '+Long2Str(chatend)+':00 Hours.'
  121.     else
  122.       tempstr := ' Chat Function.......OFF';
  123.     FastWrite(tempstr, 12, 12, Title_Color);
  124.     if limit_lines then
  125.       tempstr := ' Message Length......LIMITED to '+Long2Str(max_msg_lines)+' lines.'
  126.     else
  127.       tempstr := ' Message Length......NOT LIMITED.';
  128.     FastWrite(tempstr, 13, 12, Title_Color);
  129.     if extra_time_sw then
  130.       tempstr := ' Extra time..........'+Long2Str(extra_time_val)+
  131.       ' Minutes given from '+Long2Str(ExtraTimeStart)+
  132.       ':00 to '+Long2Str(ExtraTimeStop)+':00'
  133.     else
  134.       tempstr := ' Extra time..........NOT active.';
  135.     FastWrite(tempstr, 14, 12, Title_Color);
  136.   end;
  137.   
  138.   
  139.   procedure full_screen_edit(EditFile : StrStd; Mode : Char; var abort : Boolean);
  140.   
  141.   type
  142.     BorderElements  = (topleft, topright, botleft, botright, horiz, vert);
  143.     BorderChars     = array[BorderElements] of Char;
  144.     
  145.   const
  146.     Border : BorderChars = '┌┐└┘─│';
  147.     Title_Color     = $17;
  148.     ExitCommands : array[0..6] of Char = (#2, ^K, ^Q, #2, #0, #68, #0);
  149.     
  150.   var
  151.     EdData          : EdCB;
  152.     BufPtr,
  153.     Routine         : Pointer;
  154.     OK              : Boolean;
  155.     Cx1, Cy1,
  156.     Cx2, Cy2        : Byte;
  157.     
  158.     
  159.     procedure DrawBox(Border : BorderChars; X1, Y1, X2, Y2 : Byte);
  160.       {-Draw a box around an editor window}
  161.     var
  162.       i               : Word;
  163.       bar             : string;
  164.       barlen          : Byte absolute bar;
  165.       
  166.     begin                         {DrawBox}
  167.     
  168.       {Build horizontal bar}
  169.       barlen := 3+X2-X1;
  170.       FillChar(bar[1], barlen, Border[horiz]);
  171.       
  172.       {Draw top bar}
  173.       bar[1] := Border[topleft];
  174.       bar[barlen] := Border[topright];
  175.       FastWrite(bar, Y1, X1, Title_Color);
  176.       
  177.       {Draw bottom bar}
  178.       bar[1] := Border[botleft];
  179.       bar[barlen] := Border[botright];
  180.       FastWrite(bar, Y2+2, X1, Title_Color);
  181.       
  182.       {Vertical bars}
  183.       for i := Succ(Y1) to Succ(Y2) do
  184.         begin
  185.           FastWrite(Border[vert], i, X1, Title_Color);
  186.           FastWrite(Border[vert], i, X2+2, Title_Color);
  187.         end;
  188.     end;                          {DrawBox}
  189.     
  190.     
  191.     procedure deinit;             {Release heap and restore screen}
  192.     
  193.     begin
  194.       ReleaseBinaryEditorHeap(EdData);
  195.       if OK then
  196.         begin
  197.           RestoreWindow(1, 1, CurrentWidth, Succ(CurrentHeight), True, BufPtr);
  198.           GotoXY(WhereX, WhereY-2)
  199.         end
  200.       else
  201.         ClrScr;
  202.     end;
  203.     
  204.     
  205.   begin
  206.     abort := False;
  207.     if Mode = 'W' then
  208.       begin
  209.         Cx1 := 5;
  210.         Cy1 := 2;
  211.         Cx2 := 78;
  212.         Cy2 := 20;
  213.         Routine := Addr(UserEventCheck);
  214.       end
  215.     else
  216.       begin
  217.         Cx1 := 3;
  218.         Cy1 := 2;
  219.         Cx2 := 79;
  220.         Cy2 := 20;
  221.         Routine := nil;
  222.       end;
  223.     while EditFile = '' do
  224.       EditFile := prompt('Name of file to edit', 80, 'ES');
  225.     if (InitBinaryEditor(EdData, Word(min(MaxAvail-1000, MaxFileSize)), Cx1, Cy1,
  226.       Cx2, Cy2, True, (EdOptInsert or EdOptTAB), '', ExitCommands, Routine) <> 0) then
  227.       begin
  228.         WriteLn(Com);
  229.         WriteLn(Com, 'Insufficient memory available.');
  230.         Exit;
  231.       end;
  232.     OK := SaveWindow(1, 1, CurrentWidth, Succ(CurrentHeight), True, BufPtr);
  233.     ClrScr;
  234.     DrawBox(Border, Cx1-2, Pred(Cy1), Pred(Cx2), Succ(Cy2));
  235.     if (ReadFileBinaryEditor(EdData, EditFile) > 1) then
  236.       begin
  237.         deinit;
  238.         WriteLn(Com);
  239.         WriteLn(Com, 'File too large to edit.');
  240.         Exit;
  241.       end;
  242.     ResetBinaryEditor(EdData);
  243.     case UseBinaryEditor(EdData, '') of
  244.       -1, 1 :
  245.         if ModifiedFileBinaryEditor(EdData) then
  246.           begin
  247.             if (SaveFileBinaryEditor(EdData, True) <> 0) then
  248.               begin
  249.                 WriteLn(Com);
  250.                 WriteLn(Com, 'File save failed.');
  251.               end;
  252.           end
  253.         else
  254.           abort := True;
  255.       0 :
  256.         begin
  257.           abort := True;
  258.           WriteLn(Com);
  259.           WriteLn(Com, 'File was not saved.');
  260.         end;
  261.     end;
  262.     deinit;
  263.   end;
  264.   
  265.   
  266. end.                              {of MISC.PAS}
  267. 
  268.